home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / lzhpas.zip / LZHTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-01  |  3KB  |  122 lines
  1. Program LZHTest;
  2.  
  3. uses LZH;
  4.  
  5. CONST
  6.   MaxBuf = 4096;     { Must be bigger than the biggest chunk being asked for. }
  7.  
  8.  
  9. Type
  10.   BufType = Array[1..MaxBuf] OF BYTE;
  11.   BufPtr = ^BufType;
  12.  
  13.  
  14. VAR
  15.   InBuf,OutBuf : BufPtr;
  16.   infile,Outfile : FILE;
  17.   s : STRING;
  18.   Bytes_Written : LongInt;
  19.   Size : LongInt;
  20.   Temp : WORD;
  21.  
  22.  
  23. {$F+}
  24.  
  25. Procedure GetBlock(VAR Target; NoBytes:Word; VAR Actual_Bytes:Word);
  26. CONST
  27.   Posn : Word = 1;
  28.   Buf : Word = 0;
  29.  
  30. VAR
  31.   Temp:Word;
  32.  
  33. BEGIN
  34.   IF (Posn > Buf) OR (Posn + NoBytes > SUCC(Buf)) THEN
  35.     BEGIN
  36.       IF Posn > Buf THEN
  37.         BEGIN
  38.           BlockRead(InFile,InBuf^,MaxBuf,Buf);
  39.           Write('+');
  40.         END
  41.       ELSE
  42.         BEGIN
  43.           Move(InBuf^[Posn],InBuf^[1],Buf-Posn);
  44.           BlockRead(InFile,InBuf^[Buf-Posn],MaxBuf-(Buf-Posn),Temp);
  45.           Buf := Buf-Posn+Temp;
  46.           Write('+');
  47.         END;
  48.       IF Buf = 0 THEN
  49.         BEGIN
  50.           Actual_Bytes := 0;
  51.           Writeln;
  52.           Exit;
  53.         END;
  54.       Posn := 1;
  55.     END;
  56.   Move(InBuf^[Posn],Target,NoBytes);
  57.   INC(Posn,NoBytes);
  58.   IF Posn > SUCC(Buf) THEN
  59.     Actual_Bytes := NoBytes -(Posn-SUCC(Buf))
  60.   ELSE Actual_Bytes := NoBytes;
  61. END;
  62.  
  63.  
  64. Procedure PutBlock(VAR Source; NoBytes:Word; VAR Actual_Bytes:Word);
  65. CONST
  66.   Posn : Word= 1;
  67.  
  68. VAR
  69.   Temp:Word;
  70.  
  71. BEGIN
  72.   If NoBytes = 0 THEN    { Flush condition }
  73.     BEGIN
  74.       BlockWrite(OutFile,OutBuf^,PRED(Posn),Temp);
  75.       EXIT;
  76.     END;
  77.   IF (Posn > MaxBuf) OR (Posn + NoBytes > SUCC(MaxBuf)) THEN
  78.     BEGIN
  79.       BlockWrite(OutFile,OutBuf^,PRED(Posn),Temp);
  80.       Posn := 1;
  81.     END;
  82.   Move(Source,OutBuf^[Posn],NoBytes);
  83.   INC(Posn,NoBytes);
  84.   Actual_Bytes := NoBytes;
  85. END;
  86.  
  87.  
  88. {$F-}
  89.  
  90. BEGIN
  91.   IF (paramcount <> 3) THEN
  92.     BEGIN
  93.       Writeln('Usage:lzhuf e(compression)|d(uncompression) infile outfile');
  94.       halt(1);
  95.     END;
  96.   s := paramstr(1);
  97.   IF NOT (s[1] IN ['D','E','d','e']) THEN
  98.     Halt(1);
  99.   Assign(infile,paramstr(2));
  100.   reset(infile,1);
  101.   Assign(outfile,Paramstr(3));
  102.   Rewrite(outfile,1);
  103.   New(InBuf);
  104.   New(OutBuf);
  105.   IF (upcase(s[1]) = 'E') THEN
  106.     BEGIN
  107.        Size := Filesize(InFile);
  108.        BlockWrite(OutFile,Size,Sizeof(LongInt));
  109.        LZHPack(Bytes_Written,GetBlock,PutBlock);
  110.        PutBlock(Size,0,Temp);
  111.     END
  112.   ELSE
  113.     BEGIN
  114.       BlockRead(Infile,Size,Sizeof(LongInt));
  115.       LZHUnPack(Size,GetBlock,PutBlock);
  116.       PutBlock(Size,0,Temp);
  117.     END;
  118.   Dispose(OutBuf);
  119.   Dispose(InBuf);
  120.   Close(Infile);
  121.   Close(OutFile);
  122. END.